## A new generic function with no default method
setGeneric(name = "APAStyler",
  def = function(object, ...)
    standardGeneric("APAStyler")
)

setMethod(APAStyler,
  signature = "lm",
  definition = function(object, digits = 2, pdigits, copy = TRUE, ...) {
    if (missing(pdigits)) pdigits <- digits + 1

    s <- summary(object)
    ctable <- coef(s)
    cstars <- star(ctable[, "Pr(>|t|)"])
    ctable <- format(round(ctable, digits = digits),
      trim = TRUE, nsmall = digits)
    est <- paste(ctable[, "Estimate"], cstars, " (",
      ctable[, "Std. Error"], ")", sep = "")

    ci <- format(round(confint(object, level = 0.95), digits = digits),
      nsmall = digits, trim = TRUE)
    ci <- paste("[", ci[, 1], ", ", ci[, 2], "]", sep = "")


    F <- s$fstatistic
    p <- pf(F[1], F[2], F[3], lower.tail = FALSE)

    r2 <- paste(format(round(s$r.squared, digits = digits),
      nsmall = digits), star(p), sep = "")
    F <- format(round(F, digits = digits), nsmall = digits, trim = TRUE)

    if (identical(round(p[[1]], digits = pdigits), 0)) {
      p <- paste("p < .", paste(rep(0, pdigits - 1), collapse = ""),
        "1", sep = "")
    } else {p <- paste("p = ", format(round(p, digits = pdigits),
      nsmall = pdigits), sep = "")
    }

    F <- c(paste("F(", F[2], ", ", F[3], ") = ", F[1], sep = ""), p)

    out <- matrix(character(1), nrow = length(est) + 2, ncol = 2,
      dimnames = list(c("Constant", rownames(ctable)[-1], "R^2", "F"),
        c("B (SE)", "95% CI")))

    out[1:length(est), 1] <- est
    out[1:length(ci), 2] <- ci
    out["R^2", 1] <- r2
    out["F", ] <- F

    if (copy) write.table(out, file = "clipboard", ...)
    print(noquote(out))
    return(invisible(out))
  }
)

setMethod(APAStyler,
  signature = "mira",
  definition = function(object, lmobject, digits = 2, pdigits, copy = TRUE, ...) {
    if (!inherits(object[["analyses"]][[1]], "lm"))
      stop("mira object must use a model that inherits from class 'lm' such as 'lm' or 'glm'")

    if (missing(pdigits)) pdigits <- digits + 1
    F <- r2 <- NULL

    ctable <- summary(pool(object))
    cstars <- star(ctable[, "Pr(>|t|)"])
    ctable <- format(round(ctable, digits = digits),
      trim = TRUE, nsmall = digits)

    est <- paste(ctable[, "est"], cstars, " (",
      ctable[, "se"], ")", sep = "")

    ci <- paste("[", ctable[, "lo 95"], ", ", ctable[, "hi 95"], "]", sep = "")

    out <- matrix(character(1), nrow = length(est), ncol = 2,
      dimnames = list(c("Constant", rownames(ctable)[-1]),
        c("B (SE)", "95% CI")))
    out[1:length(est), 1] <- est
    out[1:length(ci), 2] <- ci

    if (identical(class(object[["analyses"]][[1]]), "lm")) {
      r2 <- pool.r.squared(object)[, "est"]

      if (!missing(lmobject)) {
        df <- summary(lmobject)$fstatistic[2:3]
        F <- f.r2(r2, df[1], df[2])[1:3]
        p <- f.r2(r2, df[1], df[2])[4]

        r2 <- c(paste(format(round(r2, digits = digits),
          nsmall = digits), star(p), sep = ""), "")

        F <- format(round(F, digits = digits), nsmall = digits, trim = TRUE)

        if (identical(round(p[[1]], digits = pdigits), 0)) {
          p <- paste("p < .", paste(rep(0, pdigits - 1), collapse = ""),
            "1", sep = "")
        } else {p <- paste("p = ", format(round(p, digits = pdigits),
          nsmall = pdigits), sep = "")
        }

        F <- c(paste("F(", F[2], ", ", F[3], ") = ", F[1], sep = ""), p)
        warning("Using the degrees of freedom for the listwise deleted model for the F test and R^2 significance.",
          call. = FALSE)
      } else {
        r2 <- c(paste(format(round(r2, digits = digits),
         nsmall = digits), sep = ""), "")
      }
      out <- rbind(out, "R^2" = r2, "F" = F)
    } else if (!missing(lmobject)) warning("lmobject argument ignored")

    if (copy) write.table(out, file = "clipboard", sep = sep, ...)

    print(noquote(out))

    return(invisible(out))
  }
)

setMethod(APAStyler,
  signature = "SEMSummary",
  definition = function(object, digits = 2, cov = c("cov", "cor", "both"), copy = TRUE, ...) {

    cov <- match.arg(cov)
    mat <- switch(cov,
      cov = {m <- round(object$Sigma, digits = digits)
        m[] <- as.character(m)
        m[lower.tri(m)] <- ""
        diag(m) <- " - "
        m},
      cor = {m <- round(object$sSigma, digits = digits)
        m[] <- as.character(m)
        m[lower.tri(m)] <- ""
        diag(m) <- " - "
        m},
      both = {mv <- round(object$Sigma, digits = digits)
        mc <- round(object$sSigma, digits = digits)
        mv[] <- as.character(mv)
        mv[lower.tri(mv)] <- mc[lower.tri(mc)]
        diag(mv) <- " - "
        mv})

    X <- lapply(object[c("n", "nmissing", "mu", "stdev", "coverage")],
      round, digits = digits)
    out.table <- matrix("", nrow = length(object$names), ncol = 3 + length(object$names))
    rownames(out.table) <- paste(seq_along(object$names), ". ", object$names, sep = '')
    colnames(out.table) <- c("N", "M", "SD", paste(seq_along(object$names), ".", sep = ''))

    out.table[, "N"] <- round(X$n - X$nmissing, digits = digits)
    out.table[, "M"] <- X$mu
    out.table[, "SD"] <- X$stdev
    out.table[, -c(1:3)] <- mat

    mtable <- X$coverage
    mtable[] <- as.character(mtable)
    mtable[lower.tri(mtable)] <- ""


    if (copy) {
      if (!exists("sep")) sep <- "\t"
      copyout <- cbind(rownames(out.table), out.table)
      copyout <- rbind(colnames(copyout), copyout)
      write.table(copyout, file = "clipboard", sep = sep, row.names = FALSE, col.names = FALSE, ...)
    }
    output <- list(table = out.table, coverage = mtable)

    print(noquote(out.table))
    cat("\nPercentage of coverage for each pairwise covariance or correlation\n\n")
    print(noquote(mtable))

    return(invisible(output))
  })
